PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/filedll.com/FDLGDLL.PAS

Pascal/Delphi Source File | 1991-04-23 | 5.5 KB | 204 lines

library Fdlgdll;

{$R FILEDLGS}



uses WinTypes, WinProcs, WinDos, Strings;


const
  id_FName = 100;
  id_FPath = 101;
  id_FList = 102;
  id_DList = 103;

const
  fsFileSpec = fsFileName + fsExtension;

type
  TDWord = record
    Lo, Hi: Word;
  end;

var
  GCaption: PChar;
  GFilePath: PChar;
  GPathName: array[0..fsPathName] of Char;
  GExtension: array[0..fsExtension] of Char;
  GFileSpec: array[0..fsFileSpec] of Char;

function GetFileName(FilePath: PChar): PChar;
var
  P: PChar;
begin
  P := StrRScan(FilePath, '\');
  if P = nil then P := StrRScan(FilePath, ':');
  if P = nil then GetFileName := FilePath else GetFileName := P + 1;
end;

function GetExtension(FilePath: PChar): PChar;
var
  P: PChar;
begin
  P := StrScan(GetFileName(FilePath), '.');
  if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
end;

function FileDialog(Dialog: HWnd; Message, WParam: Word;
  LParam: TDWord): Bool; export;
var
  PathLen: Word;
  P: PChar;

procedure UpdateFileName;
begin
  SetDlgItemText(Dialog, id_FName, StrLower(GPathName));
  SendDlgItemMessage(Dialog, id_FName, em_SetSel, 0, $7FFF0000);
end;

procedure SelectFileName;
begin
  SendDlgItemMessage(Dialog, id_FName, em_SetSel, 0, $7FFF0000);
  SetFocus(GetDlgItem(Dialog, id_FName));
end;

function UpdateListBoxes: Boolean;
var
  Result: Integer;
  Path: array[0..fsPathName] of Char;
begin
  UpdateListBoxes := False;
  if GetDlgItem(Dialog, id_FList) <> 0 then
  begin
    StrCopy(Path, GPathName);
    Result := DlgDirList(Dialog, Path, id_FList, id_FPath, 0);
    if Result <> 0 then DlgDirList(Dialog, '*.*', id_DList, 0, $C010);
  end else
  begin
    StrLCopy(Path, GPathName, GetFileName(GPathName) - GPathName);
    StrLCat(Path, '*.*', fsPathName);
    Result := DlgDirList(Dialog, Path, id_DList, id_FPath, $C010);
  end;
  if Result <> 0 then
  begin
    StrLCopy(GFileSpec, GetFileName(GPathName), fsFileSpec);
    StrCopy(GPathName, GFileSpec);
    UpdateFileName;
    UpdateListBoxes := True;
  end;
end;

begin
  FileDialog := True;
  case Message of
    wm_InitDialog:
      begin
        SendDlgItemMessage(Dialog, id_FName, em_LimitText, fsPathName, 0);
        if GCaption <> nil then SetWindowText(Dialog, GCaption);
        StrLCopy(GPathName, GFilePath, fsPathName);
        StrLCopy(GExtension, GetExtension(GPathName), fsExtension);
        if not UpdateListBoxes then
        begin
          StrCopy(GPathName, '*.*');
          UpdateListBoxes;
        end;
        SelectFileName;
        Exit;
      end;
    wm_Command:
      case WParam of
        id_FName:
          begin
            if LParam.Hi = en_Change then
              EnableWindow(GetDlgItem(Dialog, id_Ok),
                SendMessage(LParam.lo, wm_GetTextLength, 0, 0) <> 0);
            Exit;
          end;
        id_FList:
          if (LParam.Hi = lbn_SelChange) or (LParam.Hi = lbn_DblClk) then
          begin
            DlgDirSelect(Dialog, GPathName, id_FList);
            UpdateFileName;
            if LParam.Hi = lbn_DblClk then
              SendMessage(Dialog, wm_Command, id_Ok, 0);
            Exit;
          end;
        id_DList:
          if (LParam.Hi = lbn_SelChange) or (LParam.Hi = lbn_DblClk) then
          begin
            DlgDirSelect(Dialog, GPathName, id_DList);
            StrCat(GPathName, GFileSpec);
            if LParam.Hi = lbn_DblClk then
              UpdateListBoxes else
              UpdateFileName;
            Exit;
          end;
        id_Ok:
          begin
            GetDlgItemText(Dialog, id_FName, GPathName, fsPathName + 1);
            FileExpand(GPathName, GPathName);
            PathLen := StrLen(GPathName);
            if (GPathName[PathLen - 1] = '\') or
              (StrScan(GPathName, '*') <> nil) or
              (StrScan(GPathName, '?') <> nil) or
              (GetFocus = GetDlgItem(Dialog, id_DList)) then
            begin
              if GPathName[PathLen - 1] = '\' then
                StrLCat(GPathName, GFileSpec, fsPathName);
              if not UpdateListBoxes then
              begin
                MessageBeep(0);
                SelectFileName;
              end;
              Exit;
            end;
            StrLCat(StrLCat(GPathName, '\', fsPathName),
              GFileSpec, fsPathName);
            if UpdateListBoxes then Exit;
            GPathName[PathLen] := #0;
            if GetExtension(GPathName)[0] = #0 then
              StrLCat(GPathName, GExtension, fsPathName);
            StrLower(StrCopy(GFilePath, GPathName));
            EndDialog(Dialog, 1);
            Exit;
          end;
        id_Cancel:
          begin
            EndDialog(Dialog, 0);
            Exit;
          end;
      end;
  end;
  FileDialog := False;
end;

function DoFileDialog(Window: HWnd;
  FilePath, DialogName, Caption: PChar): Boolean; export;
var
  DialogProc: TFarProc;
begin
  GFilePath := FilePath;
  GCaption := Caption;
  DialogProc := MakeProcInstance(@FileDialog, HInstance);
  DoFileDialog := DialogBox(HInstance, DialogName, Window, DialogProc) = 1;
  FreeProcInstance(DialogProc);
end;

function DoFileOpen(Window: HWnd; FilePath: PChar): Boolean; export;
begin
  DoFileOpen := DoFileDialog(Window, FilePath, 'FileOpen', nil);
end;

function DoFileSave(Window: HWnd; FilePath: PChar): Boolean; export;
begin
  DoFileSave := DoFileDialog(Window, FilePath, 'FileSave', nil);
end;

exports DoFileDialog index 1;
exports DoFileOpen   index 2;
exports DoFileSave   index 3;

begin
end.